home *** CD-ROM | disk | FTP | other *** search
/ CD ROM Paradise Collection 4 / CD ROM Paradise Collection 4 1995 Nov.iso / program / swagd_f.zip / DRIVES.SWG / 0022_VOLABEL3.PAS.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  2KB  |  84 lines
  1. {
  2. >I am having difficulty changing a disk volume Label using Turbo Pascal.
  3. >Does anyone know how to acComplish this?
  4. }
  5. Uses
  6.   Dos;
  7.  
  8. Type fcbType = Record
  9.                  drive   : Byte;
  10.                  name    : Array[1..8] of Char;
  11.                  ext     : Array[1..3] of Char;
  12.                  fpos    : Word;
  13.                  recsize : Word;
  14.                  fsize   : LongInt;
  15.                  fdate   : Word;
  16.                  ftime   : Word;
  17.                  reserv  : Array[1..8] of Byte;
  18.                  currec  : Byte;
  19.                  relrec  : LongInt;
  20.                end;
  21.      extfcb =  Record
  22.                  flag    : Byte;                  { must be $ff! }
  23.                  reserv  : Array[1..5] of Byte;
  24.                  attrib  : Byte;
  25.                  fcb     : fcbType;
  26.                end;
  27.  
  28.  
  29. Function GetVolLabel(drive:Char):String;
  30. Var sr : SearchRec;
  31. begin
  32.   findfirst(drive+':\*.*',VolumeID,sr);
  33.   if Doserror=0 then GetVolLabel:=sr.name
  34.   else GetVolLabel:='';
  35. end;
  36.  
  37.  
  38. Procedure setfcbname(Var fcb:fcbType; name:String);
  39. Var p : Byte;
  40. begin
  41.   p:=pos('.',name);
  42.   if p=0 then begin
  43.     p:=length(name)+1;
  44.     name:=name+'.';
  45.     end;
  46.   fillChar(fcb.name,11,' ');
  47.   move(name[1],fcb.name,p-1);
  48.   move(name[p+1],fcb.ext,length(name)-p);
  49. end;
  50.  
  51.  
  52. Procedure SetVolLabel(drive:Char; vLabel:String);
  53. Var fcb  : extfcb;
  54.     vl   : PathStr;
  55.     regs : Registers;
  56.     f    : File;
  57. begin
  58.   vl:=GetVolLabel(drive);
  59.   fcb.flag:=$ff;
  60.   fcb.attrib:=VolumeID;
  61.   if vl<>'' then begin
  62.     setfcbname(fcb.fcb,vl);
  63.     fcb.fcb.drive:=ord(UpCase(drive))-64;
  64.     regs.ah:=$13;                { Delete File }
  65.     regs.ds:=seg(fcb);
  66.     regs.dx:=ofs(fcb);
  67.     msDos(regs);
  68.     end;
  69.   if vLabel<>'' then begin
  70.     fcb.fcb.drive:=ord(UpCase(drive))-64;
  71.     setfcbname(fcb.fcb,vLabel);
  72.     With regs do begin
  73.       ah:=$16;                  { Create File }
  74.       ds:=seg(fcb);
  75.       dx:=ofs(fcb);
  76.       msDos(regs);
  77.       ah:=$10;                  { Close File }
  78.       ds:=seg(fcb);
  79.       dx:=ofs(fcb);
  80.       msDos(regs);
  81.       end;
  82.     end;
  83. end;
  84.